home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-1 / rtt.sit / rttinlin.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-09-19  |  64.8 KB  |  1,950 lines  |  [TEXT/MPS ]
  1. /*
  2.  * rttinlin.c contains routines which produce the in-line version of an
  3.  *  operation and put it in the data base.
  4.  */
  5. #include "rtt.h"
  6.  
  7. /*
  8.  * prototypes for static functions. 
  9.  */
  10. hidden struct il_code *abstrcomp Params((struct node *n, int indx_stor,
  11.                                     int chng_stor, int escapes));
  12. hidden novalue         abstrsnty Params((struct token *t, int typcd,
  13.                                    int indx_stor, int chng_stor));
  14. hidden int             body_anlz Params((struct node *n, int *does_break,
  15.                                    int may_mod, int const_cast, int all));
  16. hidden struct il_code *body_fnc  Params((struct node *n));
  17. hidden novalue         chkrettyp Params((struct node *n));
  18. hidden novalue         chng_ploc Params((int typcd, struct node *src));
  19. hidden novalue         cnt_bufs  Params((struct node *cnv_typ));
  20. hidden struct il_code *il_walk   Params((struct node *n));
  21. hidden struct il_code *il_var    Params((struct node *n));
  22. hidden int             is_addr   Params((struct node *dcltor, int modifier));
  23. hidden novalue         lcl_tend  Params((struct node *n));
  24. hidden int             mrg_abstr Params((int sum, int typ));
  25. hidden int             strct_typ Params((struct node *typ, int *is_reg));
  26.  
  27. static int body_ret; /* RetInt, RetDbl, and/or RetOther for current body */
  28. static int ret_flag; /* DoesFail, DoesRet, and/or DoesSusp for current body */
  29. int fnc_ret;         /* RetInt, RetDbl, RetNoVal, or RetSig for current func */
  30.  
  31. #ifndef Rttx
  32.  
  33. /*
  34.  * body_prms is a list of symbol table entries for identifiers that must
  35.  *  be passed as parameters to the function implementing the current
  36.  *  body statement. The id_type of an identifier may be changed in the
  37.  *  symbol table while the body function is being produced; for example,
  38.  *  a tended descriptor is accessed through a parameter that is a pointer
  39.  *  to a descriptor, rather than being accessed as an element of a descriptor
  40.  *  array in a struct.
  41.  */
  42. struct var_lst {
  43.    struct sym_entry *sym;
  44.    int id_type;            /* saved value of id_type from sym */
  45.    struct var_lst *next;
  46.    };
  47. struct var_lst *body_prms;
  48. int n_bdy_prms;        /* number of entries in body_prms list */
  49. int rslt_loc;        /* flag: function passed addr of result descriptor */
  50.  
  51. char prfx3;        /* 3rd prefix char; used for unique body func names */
  52.  
  53. /*
  54.  * in_line - place in the data base in-line code for an operation and
  55.  *   produce C functions for body statements.
  56.  */
  57. novalue in_line(n)
  58. struct node *n;
  59.    {
  60.    struct sym_entry *sym;
  61.    int i;
  62.    int nvars;
  63.    int ntend;
  64.  
  65.    prfx3 = ' '; /* reset 3rd prefix char for body functions */
  66.  
  67.    /*
  68.     * Set up the local symbol table in the data base for the in-line code.
  69.     *  This symbol table has an array of entries for the tended variables
  70.     *  in the declare statement, if there is one. Determine how large the
  71.     *  array must be and create it.
  72.     */
  73.    ntend = 0;
  74.    for (sym = dcl_stk->tended; sym != NULL; sym = sym->u.tnd_var.next)
  75.       ++ntend;
  76.    if (ntend == 0)
  77.       cur_impl->tnds = NULL;
  78.    else
  79.       cur_impl->tnds = (struct tend_var *)alloc((unsigned int)
  80.          (sizeof(struct tend_var) * ntend));
  81.    cur_impl->ntnds = ntend;
  82.    i = 0;
  83.  
  84.    /*
  85.     * Go back through the declarations and fill in the array for the 
  86.     *  tended part of the data base symbol table. Array entries contain
  87.     *  an indication of the type of tended declaration, the C code to
  88.     *  initialize the variable if there is any, and, for block pointer
  89.     *  declarations, the type of block. rtt's symbol table is updated to
  90.     *  contain the variable's offset into the data base's symbol table.
  91.     *  Note that parameters are considered part of the data base's symbol
  92.     *  table when computing the offset and il_indx initially contains
  93.     *  their number.
  94.     */
  95.    for (sym = dcl_stk->tended; sym != NULL; sym = sym->u.tnd_var.next) {
  96.       cur_impl->tnds[i].var_type = sym->id_type;
  97.       cur_impl->tnds[i].init = inlin_c(sym->u.tnd_var.init, 0);
  98.       cur_impl->tnds[i].blk_name = sym->u.tnd_var.blk_name;
  99.       sym->il_indx = il_indx++;
  100.       ++i;
  101.       }
  102.  
  103.    /*
  104.     * The data base's symbol table also has entries for non-tended
  105.     *  variables from the declare statement. Each entry has the
  106.     *  identifier for the variable and the declaration (redundantly
  107.     *  including the identifier). Once again the offset for the data
  108.     *  base symbol table is stored in rtt's symbol table.
  109.     */
  110.    nvars = -il_indx;  /* pre-subtract preceding number of entries */
  111.    for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next)
  112.       sym->il_indx = il_indx++;
  113.    nvars += il_indx;  /* compute number of entries in this part of table */
  114.    cur_impl->nvars = nvars;
  115.    if (nvars > 0) {
  116.       cur_impl->vars = (struct ord_var *)alloc((unsigned int)
  117.          (sizeof(struct ord_var) * nvars));
  118.       i = 0;
  119.       for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next) {
  120.          cur_impl->vars[i].name = sym->image;
  121.          cur_impl->vars[i].dcl = ilc_dcl(sym->u.declare_var.tqual,
  122.             sym->u.declare_var.dcltor, sym->u.declare_var.init);
  123.          ++i;
  124.          }
  125.       }
  126.  
  127.    abs_ret = NoAbstr;           /* abstract clause not encountered yet */
  128.    cur_impl->in_line = il_walk(n); /* produce in-line code for operation */
  129.    }
  130.  
  131. /*
  132.  * il_walk - walk the syntax tree producing in-line code.
  133.  */
  134. static struct il_code *il_walk(n)
  135. struct node *n;
  136.    {
  137.    struct token *t;
  138.    struct node *n1;
  139.    struct node *n2;
  140.    struct il_code *il;
  141.    struct il_code *il1;
  142.    struct sym_entry *sym;
  143.    struct init_tend *tnd;
  144.    int dummy_int;
  145.    int ntend;
  146.    int typcd;
  147.  
  148.    if (n == NULL)
  149.       return NULL;
  150.  
  151.    t =  n->tok;
  152.  
  153.    switch (n->nd_id) {
  154.       case PrefxNd:
  155.          switch (t->tok_id) {
  156.             case '{':
  157.                /*
  158.                 * RTL code: { <actions> }
  159.                 */
  160.                il = il_walk(n->u[0].child);
  161.                break;
  162.             case '!':
  163.                /*
  164.                 * RTL type-checking and conversions: ! <simple-type-check>
  165.                 */
  166.                il = new_il(IL_Bang, 1);
  167.                il->u[0].fld = il_walk(n->u[0].child);
  168.                break;
  169.             case Body:
  170.                /*
  171.                 * RTL code: body { <c-code> }
  172.                 */
  173.                il = body_fnc(n);
  174.                break;
  175.             case Inline:
  176.                /*
  177.                 * RTL code: inline { <c-code> }
  178.                 *
  179.                 *  An in-line code "block" in the data base starts off
  180.                 *  with an indication of whether execution falls through
  181.                 *  the code and a list of tended descriptors needed by the
  182.                 *  in-line C code. The list indicates the kind of tended
  183.                 *  descriptor. The list is determined by walking to the
  184.                 *  syntax tree for the C code; tend_lst points to its
  185.                 *  beginning. The last item in the block is the C code itself.
  186.                 */
  187.                free_tend();
  188.                lcl_tend(n);
  189.                if (tend_lst == NULL)
  190.                   ntend = 0;
  191.                else
  192.                   ntend = tend_lst->t_indx + 1;
  193.                il = new_il(IL_Block, 3 + ntend);
  194.                /*
  195.                 * Only need "fall through" info from body_anlz().
  196.                 */
  197.                il->u[0].n = body_anlz(n->u[0].child, &dummy_int, 0, 0, 0);
  198.                il->u[1].n = ntend;
  199.                for (tnd = tend_lst; tnd != NULL; tnd = tnd->next)
  200.                   il->u[2 + tnd->t_indx].n = tnd->init_typ;
  201.                il->u[ntend + 2].c_cd = inlin_c(n->u[0].child, 0);
  202.                if (!il->u[0].n)
  203.                   clr_prmloc(); /* execution does not continue */
  204.                break;
  205.             }
  206.          break;
  207.       case BinryNd:
  208.          switch (t->tok_id) {
  209.             case Runerr:
  210.                /*
  211.                 * RTL code: runerr( <message-number> )
  212.                 *           runerr( <message-number>, <descriptor> )
  213.                 */
  214.                if (n->u[1].child == NULL)
  215.                   il = new_il(IL_Err1, 1);
  216.                else {
  217.                   il = new_il(IL_Err2, 2);
  218.                   il->u[1].fld = il_var(n->u[1].child);
  219.                   }
  220.                il->u[0].n = atol(n->u[0].child->tok->image);
  221.                /*
  222.                 * Execution cannot continue on this execution path.
  223.                 */
  224.                clr_prmloc();
  225.                break;
  226.             case And:
  227.                /*
  228.                 * RTL type-checking and conversions:
  229.                 *   <type-check> && <type_check>
  230.                 */
  231.                il = new_il(IL_And, 2);
  232.                il->u[0].fld = il_walk(n->u[0].child);
  233.                il->u[1].fld = il_walk(n->u[1].child);
  234.                break;
  235.             case Is:
  236.                /*
  237.                 * RTL type-checking and conversions:
  238.                 *   is: <icon-type> ( <variable> )
  239.                 */
  240.                il = new_il(IL_Is, 2);
  241.                il->u[0].n = icn_typ(n->u[0].child);
  242.                il->u[1].fld = il_var(n->u[1].child);
  243.                break;
  244.             }
  245.          break;
  246.       case ConCatNd:
  247.          /*
  248.           * "Glue" for two constructs.
  249.           */
  250.          il = new_il(IL_Lst, 2);
  251.          il->u[0].fld = il_walk(n->u[0].child);
  252.          il->u[1].fld = il_walk(n->u[1].child);
  253.          break;
  254.       case AbstrNd:
  255.          /*
  256.           * RTL code: abstract { <type-computations> }
  257.           *
  258.           *  Remember the return statement if there is one. It is used for
  259.           *  type checking when types are easily determined.
  260.           */
  261.          il = new_il(IL_Abstr, 2);
  262.          il->u[0].fld = abstrcomp(n->u[0].child, 0, 0, 0);
  263.          il1 = abstrcomp(n->u[1].child, 0, 0, 1);
  264.          il->u[1].fld = il1;
  265.          if (il1 != NULL) {
  266.             if (abs_ret != NoAbstr)
  267.                errt1(t,"only one abstract return may be on any execution path");
  268.             if (il1->il_type == IL_IcnTyp || il1->il_type == IL_New)
  269.                abs_ret = il1->u[0].n;
  270.             else
  271.                abs_ret = SomeType;
  272.             }
  273.          break;
  274.       case TrnryNd:
  275.          switch (t->tok_id) {
  276.             case If: {
  277.                /*
  278.                 * RTL code for "if" statements:
  279.                 *  if <type-check> then <action>
  280.                 *  if <type-check> then <action> else <action>
  281.                 *
  282.                 *  <type-check> may include parameter conversions that create
  283.                 *  new scoping. It is necessary to keep track of parameter
  284.                 *  types and locations along success and failure paths of
  285.                 *  these conversions. The "then" and "else" actions may
  286.                 *  also establish new scopes (if a parameter is used within
  287.                 *  a overlapping scopes that conflict, it has already been
  288.                 *  detected).
  289.                 *
  290.                 *  The "then" and "else" actions may contain abstract return
  291.                 *  statements. The types of these must be "merged" in case
  292.                 *  type checking must be done on real return or suspend
  293.                 *  statements following the "if".
  294.                 */
  295.                struct parminfo *then_prms = NULL;
  296.                struct parminfo *else_prms;
  297.                struct node *cond;
  298.                struct node *else_nd;
  299.                int sav_absret;
  300.                int new_absret;
  301.  
  302.                /*
  303.                 * Save the current parameter locations. These are in
  304.                 *  effect on the failure path of any type conversions
  305.                 *  in the condition of the "if". Also remember any
  306.                 *  information from abstract returns.
  307.                 */
  308.                else_prms = new_prmloc();
  309.                sv_prmloc(else_prms);
  310.                sav_absret = new_absret = abs_ret;
  311.  
  312.                cond = n->u[0].child;
  313.                else_nd = n->u[2].child;
  314.  
  315.                if (else_nd == NULL)
  316.                   il = new_il(IL_If1, 2);
  317.                else
  318.                   il = new_il(IL_If2, 3);
  319.                il->u[0].fld = il_walk(cond);
  320.                /*
  321.                 * If the condition is negated, the failure path is to the "then"
  322.                 *  and the success path is to the "else".
  323.                 */
  324.                if (cond->nd_id == PrefxNd && cond->tok->tok_id == '!') {
  325.                   then_prms = else_prms;
  326.                   else_prms = new_prmloc();
  327.                   sv_prmloc(else_prms);
  328.                   ld_prmloc(then_prms);
  329.                   }
  330.                il->u[1].fld = il_walk(n->u[1].child);  /* then ... */
  331.                if (else_nd == NULL) {
  332.                   mrg_prmloc(else_prms);
  333.                   ld_prmloc(else_prms);
  334.                   }
  335.                else {
  336.                   if (then_prms == NULL)
  337.                      then_prms = new_prmloc();
  338.                   sv_prmloc(then_prms);
  339.                   ld_prmloc(else_prms);
  340.                   new_absret = mrg_abstr(new_absret, abs_ret);
  341.                   abs_ret = sav_absret;
  342.                   il->u[2].fld = il_walk(else_nd);
  343.                   mrg_prmloc(then_prms);
  344.                   ld_prmloc(then_prms);
  345.                   }
  346.                abs_ret = mrg_abstr(new_absret, abs_ret);
  347.                if (then_prms != NULL)
  348.                   free(then_prms);
  349.                if (else_prms != NULL)
  350.                   free(else_prms);
  351.                }
  352.                break;
  353.             case Len_case: {
  354.                /*
  355.                 * RTL code:
  356.                 *   len_case <variable> of {
  357.                 *      <integer>: <action>
  358.                 *        ...
  359.                 *      default: <action>
  360.                 *      }
  361.                 */
  362.                struct parminfo *strt_prms;
  363.                struct parminfo *end_prms;
  364.                int n_cases;
  365.                int indx;
  366.                int sav_absret;
  367.                int new_absret;
  368.  
  369.                /*
  370.                 * A case may contain parameter conversions that create new
  371.                 *  scopes. Remember the parameter locations at the start
  372.                 *  of the len_case statement. Also remember information
  373.                 *  about abstract type returns.
  374.                 */
  375.                strt_prms = new_prmloc();
  376.                sv_prmloc(strt_prms);
  377.                end_prms = new_prmloc();
  378.                sav_absret = new_absret = abs_ret;
  379.  
  380.                /*
  381.                 * Count the number of cases; there is at least one.
  382.                 */
  383.                n_cases = 1;
  384.                for (n1 = n->u[1].child; n1->nd_id == ConCatNd;
  385.                    n1 = n1->u[0].child)
  386.                       ++n_cases;
  387.  
  388.                /*
  389.                 * The data base entry has one slot for the number of cases,
  390.                 *  one for the default clause, and two for each case. A
  391.                 *  case includes a selection integer and an action.
  392.                 */
  393.                il = new_il(IL_Lcase, 2 + 2 * n_cases);
  394.                il->u[0].n = n_cases;
  395.  
  396.                /*
  397.                 * Go through the cases, adding them to the data base entry.
  398.                 *  Merge resulting parameter locations and information
  399.                 *  about abstract type returns, then restore the starting
  400.                 *  information for the next case.
  401.                 */
  402.                indx = 2 * n_cases;
  403.                for (n1 = n->u[1].child; n1->nd_id == ConCatNd;
  404.                     n1 = n1->u[0].child) {
  405.                   il->u[indx--].fld = il_walk(n1->u[1].child->u[0].child);
  406.                   il->u[indx--].n = atol(n1->u[1].child->tok->image);
  407.                   mrg_prmloc(end_prms);
  408.                   ld_prmloc(strt_prms);
  409.                   new_absret = mrg_abstr(new_absret, abs_ret);
  410.                   abs_ret = sav_absret;
  411.                   }
  412.                /*
  413.                 * Last case.
  414.                 */
  415.                il->u[indx--].fld = il_walk(n1->u[0].child);
  416.                il->u[indx].n = atol(n1->tok->image);
  417.                mrg_prmloc(end_prms);
  418.                ld_prmloc(strt_prms);
  419.                new_absret = mrg_abstr(new_absret, abs_ret);
  420.                abs_ret = sav_absret;
  421.                /*
  422.                 * Default clause.
  423.                 */
  424.                il->u[1 + 2 * n_cases].fld = il_walk(n->u[2].child);
  425.                mrg_prmloc(end_prms);
  426.                ld_prmloc(end_prms);
  427.                abs_ret = mrg_abstr(new_absret, abs_ret);
  428.                if (strt_prms != NULL)
  429.                   free(strt_prms);
  430.                if (end_prms != NULL)
  431.                   free(end_prms);
  432.                }
  433.                break;
  434.             case Type_case: {
  435.                /*
  436.                 * RTL code:
  437.                 *   type_case <variable> of {
  438.                 *       <icon_type> : ... <icon_type> : <action>
  439.                 *          ...
  440.                 *       }
  441.                 *
  442.                 *   last clause may be: default: <action>
  443.                 */
  444.                struct node *sel;
  445.                struct parminfo *strt_prms;
  446.                struct parminfo *end_prms;
  447.                int *typ_vect;
  448.                int n_case;
  449.                int n_typ;
  450.                int n_fld;
  451.                int sav_absret;
  452.                int new_absret;
  453.  
  454.                /*
  455.                 * A case may contain parameter conversions that create new
  456.                 *  scopes. Remember the parameter locations at the start
  457.                 *  of the type_case statement. Also remember information
  458.                 *  about abstract type returns.
  459.                 */
  460.                strt_prms = new_prmloc();
  461.                sv_prmloc(strt_prms);
  462.                end_prms = new_prmloc();
  463.                sav_absret = new_absret = abs_ret;
  464.  
  465.                /*
  466.                 * Count the number of cases.
  467.                 */
  468.                n_case = 0;
  469.                for (n1 = n->u[1].child; n1 != NULL; n1 = n1->u[0].child)
  470.                   ++n_case;
  471.  
  472.                /*
  473.                 * The data base entry has one slot for the variable whose
  474.                 *  type is being tested, one for the number cases, three
  475.                 *  for each case, and, if there is default clause, one
  476.                 *  for it. Each case includes the number of types selected
  477.                 *  by the case, a vectors of those types, and the action
  478.                 *  for the case.
  479.                 */
  480.                if (n->u[2].child == NULL) {
  481.                   il = new_il(IL_Tcase1, 3 * n_case + 2);
  482.                   il->u[0].fld = il_var(n->u[0].child);
  483.                   }
  484.                else {
  485.                   /*
  486.                    * There is a default clause.
  487.                    */
  488.                   il = new_il(IL_Tcase2, 3 * n_case + 3);
  489.                   il->u[0].fld = il_var(n->u[0].child);
  490.                   il->u[3 * n_case + 2].fld = il_walk(n->u[2].child);
  491.                   mrg_prmloc(end_prms);
  492.                   ld_prmloc(strt_prms);
  493.                   }
  494.                il->u[1].n = n_case;
  495.  
  496.                /*
  497.                 * Go through the cases, adding them to the data base entry.
  498.                 *  Merge resulting parameter locations and information
  499.                 *  about abstract type returns, then restore the starting
  500.                 *  information for the next case.
  501.                 */
  502.                n_fld = 2;
  503.                for (n1 = n->u[1].child; n1 != NULL; n1 = n1->u[0].child) {
  504.                   /*
  505.                    * Determine the number types selected by the case and
  506.                    *  put the types in a vector.
  507.                    */
  508.                   sel = n1->u[1].child;
  509.                   n_typ = 0;
  510.                   for (n2 = sel->u[0].child; n2 != NULL; n2 = n2->u[0].child)
  511.                      n_typ++;
  512.                   il->u[n_fld++].n = n_typ;
  513.                   typ_vect = (int *)alloc((unsigned int)(sizeof(int) * n_typ));
  514.                   il->u[n_fld++].vect = typ_vect;
  515.                   n_typ = 0;
  516.                   for (n2 = sel->u[0].child; n2 != NULL; n2 = n2->u[0].child)
  517.                      typ_vect[n_typ++] = icn_typ(n2->u[1].child);
  518.                   /*
  519.                    * Add code for the case to the data  base entry.
  520.                    */
  521.                   new_absret = mrg_abstr(new_absret, abs_ret);
  522.                   abs_ret = sav_absret;
  523.                   il->u[n_fld++].fld = il_walk(sel->u[1].child);
  524.                   mrg_prmloc(end_prms);
  525.                   ld_prmloc(strt_prms);
  526.                   }
  527.                ld_prmloc(end_prms);
  528.                abs_ret = mrg_abstr(new_absret, abs_ret);
  529.                if (strt_prms != NULL)
  530.                   free(strt_prms);
  531.                if (end_prms != NULL)
  532.                   free(end_prms);
  533.                }
  534.                break;
  535.             case Cnv: {
  536.                /*
  537.                 * RTL code: cnv: <type> ( <source> )
  538.                 *           cnv: <type> ( <source> , <destination> )
  539.                 */
  540.                struct node *typ;
  541.                struct node *src;
  542.                struct node *dst;
  543.  
  544.                typ = n->u[0].child;
  545.                src = n->u[1].child;
  546.                dst = n->u[2].child;
  547.                typcd = icn_typ(typ);
  548.                if (src->nd_id == SymNd)
  549.                   sym = src->u[0].sym;
  550.                else if (src->nd_id == BinryNd)
  551.                   sym = src->u[0].child->u[0].sym; /* subscripted variable */
  552.                else
  553.                   errt2(src->tok, "undeclared identifier: ", src->tok->image);
  554.                if (sym->u.param_info.parm_mod) {
  555.                   fprintf(stderr, "%s: file %s, line %d, warning: ",
  556.                      progname, src->tok->fname, src->tok->line);
  557.                   fprintf(stderr, "%s may be modified\n", sym->image);
  558.                   fprintf(stderr,
  559.                   "\ticonc does not handle conversion of modified parameter\n");
  560.                   }
  561.  
  562.  
  563.                if (dst == NULL) {
  564.                   il = new_il(IL_Cnv1, 2);
  565.                   il->u[0].n = typcd;
  566.                   il->u[1].fld = il_var(src);
  567.                   /*
  568.                    * This "in-place" conversion may create a new scope for the
  569.                    *  source parameter.
  570.                    */
  571.                   chng_ploc(typcd, src);
  572.                   sym->u.param_info.parm_mod |= 1;
  573.                   }
  574.                else {
  575.                   il = new_il(IL_Cnv2, 3);
  576.                   il->u[0].n = typcd;
  577.                   il->u[1].fld = il_var(src);
  578.                   il->u[2].c_cd = inlin_c(dst, 1);
  579.                   }
  580.                }
  581.                break;
  582.             case Arith_case: {
  583.                /*
  584.                 * arith_case (<variable>, <variable>) of {
  585.                 *   C_integer: <statement>
  586.                 *   integer: <statement>
  587.                 *   C_double: <statement>
  588.                 *   }
  589.                 *
  590.                 * This construct does type conversions and provides
  591.                 *  alternate execution paths. It is necessary to keep
  592.                 *  track of parameter locations.
  593.                 */
  594.                struct node *var1;
  595.                struct node *var2;
  596.                struct parminfo *strt_prms;
  597.                struct parminfo *end_prms;
  598.                int sav_absret;
  599.                int new_absret;
  600.  
  601.                strt_prms = new_prmloc();
  602.                sv_prmloc(strt_prms);
  603.                end_prms = new_prmloc();
  604.                sav_absret = new_absret = abs_ret;
  605.  
  606.                var1 = n->u[0].child;
  607.                var2 = n->u[1].child;
  608.                n1 = n->u[2].child;   /* contains actions for the 3 cases */
  609.  
  610.                /*
  611.                 * The data base entry has a slot for each of the two variables
  612.                 *  and one for each of the three cases.
  613.                 */
  614.                il = new_il(IL_Acase, 5);
  615.                il->u[0].fld = il_var(var1);
  616.                il->u[1].fld = il_var(var2);
  617.  
  618.                /*
  619.                 * The "in-place" conversions to C_integer creates new scopes.
  620.                 */
  621.                chng_ploc(TypECInt, var1);
  622.                chng_ploc(TypECInt, var2);
  623.                il->u[2].fld = il_walk(n1->u[0].child);
  624.                mrg_prmloc(end_prms);
  625.                new_absret = mrg_abstr(new_absret, abs_ret);
  626.  
  627.  
  628.                /*
  629.                 * Conversion to integer (applicable to large integers only).
  630.                 */
  631.                ld_prmloc(strt_prms);
  632.                abs_ret = sav_absret;
  633.                il->u[3].fld  = il_walk(n1->u[1].child);
  634.                mrg_prmloc(end_prms);
  635.                new_absret = mrg_abstr(new_absret, abs_ret);
  636.  
  637.                /*
  638.                 * The "in-place" conversions to C_double creates new scopes.
  639.                 */
  640.                ld_prmloc(strt_prms);
  641.                abs_ret = sav_absret;
  642.                chng_ploc(TypCDbl, var1);
  643.                chng_ploc(TypCDbl, var2);
  644.                il->u[4].fld  = il_walk(n1->u[2].child);
  645.                mrg_prmloc(end_prms);
  646.  
  647.                ld_prmloc(end_prms);
  648.                abs_ret = mrg_abstr(new_absret, abs_ret);
  649.                free(strt_prms);
  650.                free(end_prms);
  651.                }
  652.                break;
  653.             }
  654.          break;
  655.       case QuadNd: {
  656.          /*
  657.           * RTL code: def: <type> ( <source> , <default>)
  658.           *           def: <type> ( <source> , <default> , <destination> )
  659.           */
  660.          struct node *typ;
  661.          struct node *src;
  662.          struct node *dflt;
  663.          struct node *dst;
  664.  
  665.          typ = n->u[0].child;
  666.          src = n->u[1].child;
  667.          dflt = n->u[2].child;
  668.          dst = n->u[3].child;
  669.          typcd = icn_typ(typ);
  670.          if (dst == NULL) {
  671.             il = new_il(IL_Def1, 3);
  672.             il->u[0].n = typcd;
  673.             il->u[1].fld = il_var(src);
  674.             il->u[2].c_cd = inlin_c(dflt, 0);
  675.             /*
  676.              * This "in-place" conversion may create a new scope for the
  677.              *  source parameter.
  678.              */
  679.             chng_ploc(typcd, src);
  680.             }
  681.          else {
  682.             il = new_il(IL_Def2, 4);
  683.             il->u[0].n = typcd;
  684.             il->u[1].fld = il_var(src);
  685.             il->u[2].c_cd = inlin_c(dflt, 0);
  686.             il->u[3].c_cd = inlin_c(dst, 1);
  687.             }
  688.          }
  689.          break;
  690.       }
  691.    return il;
  692.    }
  693.  
  694. /*
  695.  * il_var - produce in-line code in the data base for varibel references.
  696.  *   These include both simple identifiers and subscripted identifiers.
  697.  */
  698. static struct il_code *il_var(n)
  699. struct node *n;
  700.    {
  701.    struct il_code *il;
  702.  
  703.    if (n->nd_id == SymNd) {
  704.       il = new_il(IL_Var, 1);
  705.       il->u[0].n = n->u[0].sym->il_indx; /* offset into data base sym. tab. */
  706.       }
  707.    else if (n->nd_id == BinryNd) {
  708.       /*
  709.        * A subscripted variable.
  710.        */
  711.       il = new_il(IL_Subscr, 2);
  712.       il->u[0].n = n->u[0].child->u[0].sym->il_indx; /* sym. tab. offset */
  713.       il->u[1].n = atol(n->u[1].child->tok->image);  /* subscript */
  714.       }
  715.    else
  716.       errt2(n->tok, "undeclared identifier: ", n->tok->image);
  717.    return il;
  718.    }
  719.  
  720. /*
  721.  * abstrcomp - produce data base code for RTL abstract type computations.
  722.  *  In the process, do a few sanity checks where they are easy to do.
  723.  */
  724. static struct il_code *abstrcomp(n, indx_stor, chng_stor, escapes)
  725. struct node *n;
  726. int indx_stor;
  727. int chng_stor;
  728. int escapes;
  729.    {
  730.    struct token *t;
  731.    struct il_code *il;
  732.    int typcd;
  733.    int cmpntcd;
  734.  
  735.    if (n == NULL)
  736.       return NULL;
  737.  
  738.    t =  n->tok;
  739.  
  740.    switch (n->nd_id) {
  741.       case PrefxNd:
  742.          switch (t->tok_id) {
  743.             case Type:
  744.                /*
  745.                 * type( <variable> )
  746.                 */
  747.                il = new_il(IL_VarTyp, 1);
  748.                il->u[0].fld = il_var(n->u[0].child);
  749.                break; 
  750.             case Store:
  751.                /*
  752.                 * store[ <type> ]
  753.                 */
  754.                il = new_il(IL_Store, 1);
  755.                il->u[0].fld = abstrcomp(n->u[0].child, 1, 0, 0);
  756.                break; 
  757.             }
  758.          break;
  759.       case PstfxNd:
  760.          /*
  761.           * <type> . <attrb_name>
  762.           */
  763.          il = new_il(IL_Compnt, 2);
  764.          il->u[0].fld = abstrcomp(n->u[0].child, 0, 0, 0);
  765.          switch (t->tok_id) {
  766.             case Component:
  767.                cmpntcd = sym_lkup(t->image)->u.typ_indx;
  768.                il->u[1].n = cmpntcd;
  769.                if (escapes && !typecompnt[cmpntcd].var)
  770.                   errt3(t, typecompnt[cmpntcd].id,
  771.                     " component is an internal reference type.\n",
  772.                     "\t\tuse store[<type>.<component>] to \"dereference\" it");
  773.                break; 
  774.             case All_fields:
  775.                il->u[1].n = CM_Fields;
  776.                break; 
  777.             }
  778.          break;
  779.       case IcnTypNd:
  780.          /*
  781.           * <icon-type>
  782.           */
  783.          il = new_il(IL_IcnTyp, 1);
  784.          typcd = icn_typ(n->u[0].child);
  785.          abstrsnty(t, typcd, indx_stor, chng_stor);
  786.          il->u[0].n = typcd;
  787.          break;
  788.       case BinryNd:
  789.          switch (t->tok_id) {
  790.             case '=':
  791.                /*
  792.                 * store[ <type> ] = <type>
  793.                 */
  794.                il = new_il(IL_TpAsgn, 2);
  795.                il->u[0].fld = abstrcomp(n->u[0].child, 1, 1, 0);
  796.                il->u[1].fld = abstrcomp(n->u[1].child, 0, 0, 1);
  797.                break;
  798.             case Incr: /* union */
  799.                /*
  800.                 * <type> ++ <type>
  801.                 */
  802.                il = new_il(IL_Union, 2);
  803.                il->u[0].fld = abstrcomp(n->u[0].child, indx_stor, chng_stor,
  804.                   escapes);
  805.                il->u[1].fld = abstrcomp(n->u[1].child, indx_stor, chng_stor,
  806.                   escapes);
  807.                break;
  808.             case Intersect:
  809.                /*
  810.                 * <type> ** <type>
  811.                 */
  812.                il = new_il(IL_Inter, 2);
  813.                il->u[0].fld = abstrcomp(n->u[0].child, indx_stor, chng_stor,
  814.                   escapes);
  815.                il->u[1].fld = abstrcomp(n->u[1].child, indx_stor, chng_stor,
  816.                   escapes);
  817.                break;
  818.             case New: {
  819.                /*
  820.                 * new <icon-type> ( <type> ,  ... )
  821.                 */
  822.                struct node *typ;
  823.                struct node *args;
  824.                int nargs;
  825.  
  826.                typ = n->u[0].child;
  827.                args = n->u[1].child;
  828.  
  829.                typcd = icn_typ(typ);
  830.                abstrsnty(typ->tok, typcd, indx_stor, chng_stor);
  831.  
  832.                /*
  833.                 * Determine the number of arguments expected for this
  834.                 *  structure type.
  835.                 */
  836.                if (typcd >= 0)
  837.                   nargs = icontypes[typcd].num_comps;
  838.                else
  839.                   nargs  = 0;
  840.                if (nargs == 0)
  841.                   errt2(typ->tok,typ->tok->image," is not an aggregate type.");
  842.  
  843.                /*
  844.                 * Create the "new" construct for the data base with its type
  845.                 *  code and arguments.
  846.                 */
  847.                il = new_il(IL_New, 2 + nargs); 
  848.                il->u[0].n = typcd;
  849.                il->u[1].n = nargs;
  850.                while (nargs > 1) {
  851.                   if (args->nd_id == CommaNd)
  852.                      il->u[1 + nargs].fld = abstrcomp(args->u[1].child, 0,0,1);
  853.                   else
  854.                      errt2(typ->tok, "too few arguments for new",
  855.                         typ->tok->image);
  856.                   args = args->u[0].child;
  857.                   --nargs;
  858.                   }
  859.                if (args->nd_id == CommaNd)
  860.                   errt2(typ->tok, "too many arguments for new",typ->tok->image);
  861.                il->u[2].fld = abstrcomp(args, 0, 0, 1);
  862.                }
  863.                break;
  864.             }
  865.          break;
  866.       case ConCatNd:
  867.          /*
  868.           * "Glue" for several side effects.
  869.           */
  870.          il = new_il(IL_Lst, 2);
  871.          il->u[0].fld = abstrcomp(n->u[0].child, 0, 0, 0);
  872.          il->u[1].fld = abstrcomp(n->u[1].child, 0, 0, 0);
  873.          break;
  874.       }
  875.    return il;
  876.    }
  877.  
  878. /*
  879.  * abstrsnty - do some sanity checks on how this type is being used in
  880.  *  an abstract type computation.
  881.  */
  882. static novalue abstrsnty(t, typcd, indx_stor, chng_stor)
  883. struct token *t;
  884. int typcd;
  885. int indx_stor;
  886. int chng_stor;
  887.    {
  888.    struct icon_type *itp;
  889.  
  890.    if ((typcd < 0) || (!indx_stor))
  891.       return;
  892.  
  893.    itp = &icontypes[typcd];
  894.  
  895.    /*
  896.     * This type is being used to index the store; make sure this it
  897.     *   is a variable.
  898.     */
  899.    if (itp->deref == DrfNone)
  900.       errt2(t, itp->id, " is not a variable type");
  901.  
  902.    if (chng_stor && itp->deref == DrfCnst)
  903.       errt2(t, itp->id, " has an associated type that may not be changed");
  904.    }
  905.  
  906. /*
  907.  * body_anlz - walk the syntax tree for the C code in a body statment,
  908.  *  analyzing the code to determine the interface needed by the C function 
  909.  *  which will implement it. Also determine how many buffers are needed.
  910.  *  The value returned indicates whether it is possible for execution
  911.  *  to fall through the the code.
  912.  */
  913. static int body_anlz(n, does_break, may_mod, const_cast, all)
  914. struct node *n;   /* subtree being analyzed */
  915. int *does_break;  /* output flag: subtree contains "break;" */
  916. int may_mod;      /* input flag: this subtree might be assigned to */
  917. int const_cast;   /* input flag: expression is cast to (const ...) */
  918. int all;          /* input flag: need all information about operation */
  919.    {
  920.    struct token *t;
  921.    struct node *n1, *n2, *n3;
  922.    struct sym_entry *sym;
  923.    struct var_lst *var_ref;
  924.    int break_chk = 0;
  925.    int fall_thru;
  926.    static int may_brnchto;
  927.  
  928.    if (n == NULL)
  929.       return 1; 
  930.  
  931.    t =  n->tok;
  932.  
  933.    switch (n->nd_id) {
  934.       case PrimryNd:
  935.          switch (t->tok_id) {
  936.             case Fail:
  937.                if (all)
  938.                   ret_flag |= DoesFail;
  939.                return 0;
  940.             case Errorfail:
  941.                if (all)
  942.                   ret_flag |= DoesEFail;
  943.                return 0;
  944.             case Break:
  945.                *does_break = 1;
  946.                return 0;
  947.             default: /* do nothing special */
  948.                return 1;
  949.             }
  950.       case PrefxNd:
  951.          switch (t->tok_id) {
  952.             case Return:
  953.                if (all) {
  954.                   ret_flag |= DoesRet;
  955.                   chkrettyp(n->u[0].child); /* check for returning of C value */
  956.                   }
  957.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  958.                return 0;
  959.             case Suspend:
  960.                if (all) {
  961.                   ret_flag |= DoesSusp;
  962.                   chkrettyp(n->u[0].child); /* check for returning of C value */
  963.                   }
  964.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  965.                return 1;
  966.             case '(':
  967.                /*
  968.                 * parenthesized expression: pass along may_mod and const_cast.
  969.                 */
  970.                return body_anlz(n->u[0].child, does_break, may_mod, const_cast,
  971.                   all);
  972.             case Incr: /* ++ */
  973.             case Decr: /* -- */
  974.                /*
  975.                 * Operand may be modified.
  976.                 */
  977.                body_anlz(n->u[0].child, does_break, 1, 0, all);
  978.                return 1;
  979.             case '&':
  980.                /*
  981.                 * Unless the address is cast to a const pointer, this
  982.                 *  might be a modifiying reference.
  983.                 */
  984.                if (const_cast)
  985.                   body_anlz(n->u[0].child, does_break, 0, 0, all);
  986.                else
  987.                   body_anlz(n->u[0].child, does_break, 1, 0, all);
  988.                return 1;
  989.             case Default:
  990.                fall_thru = body_anlz(n->u[0].child, does_break, 0, 0, all);
  991.                may_brnchto = 1;
  992.                return fall_thru;
  993.             case Goto:
  994.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  995.                return 0;
  996.             default: /* unary operations the need nothing special */
  997.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  998.                return 1;
  999.             }
  1000.       case PstfxNd:
  1001.          if (t->tok_id == ';')
  1002.             return body_anlz(n->u[0].child, does_break, 0, 0, all);
  1003.          else {
  1004.             /*
  1005.              * C expressions: <expr> ++
  1006.              *                <expr> --
  1007.              *
  1008.              * modify operand
  1009.              */
  1010.             return body_anlz(n->u[0].child, does_break, 1, 0, all);
  1011.             }
  1012.       case PreSpcNd:
  1013.          body_anlz(n->u[0].child, does_break, 0, 0, all);
  1014.          return 1;
  1015.       case SymNd:
  1016.          /*
  1017.           * This is an identifier.
  1018.           */
  1019.          if (!all)
  1020.              return 1;
  1021.          sym = n->u[0].sym;
  1022.          if (sym->id_type == RsltLoc) {
  1023.             /*
  1024.              * Note that this body code explicitly references the result
  1025.              *  location of the operation.
  1026.              */
  1027.             rslt_loc = 1;
  1028.             }
  1029.          else if (sym->nest_lvl == 2) {
  1030.             /*
  1031.              * This variable is local to the operation, but declared outside
  1032.              *  the body. It must passed as a parameter to the function.
  1033.              *  See if it is in the parameter list yet.
  1034.              */
  1035.             if (!(sym->id_type & PrmMark)) {
  1036.                sym->id_type |= PrmMark;
  1037.                var_ref = NewStruct(var_lst);
  1038.                var_ref->sym = sym;
  1039.                var_ref->next = body_prms;
  1040.                body_prms = var_ref;
  1041.                ++n_bdy_prms;
  1042.                }
  1043.  
  1044.             /*
  1045.              *  Note if the variable might be assigned to.
  1046.              */
  1047.             sym->may_mod |= may_mod;
  1048.             }
  1049.          return 1;
  1050.       case BinryNd:
  1051.          switch (t->tok_id) {
  1052.             case '[': /* subscripting */
  1053.             case '.':
  1054.                /*
  1055.                 * Assignments will modify left operand.
  1056.                 */
  1057.                body_anlz(n->u[0].child, does_break, may_mod, 0, all);
  1058.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1059.                return 1;
  1060.             case '(':
  1061.                /*
  1062.                 * ( <type> ) expr
  1063.                 */
  1064.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1065.                /*
  1066.                 * See if the is a const cast.
  1067.                 */
  1068.                for (n1 = n->u[0].child; n1->nd_id == LstNd; n1 = n1->u[0].child)
  1069.                   ;
  1070.                if (n1->nd_id == PrimryNd && n1->tok->tok_id == Const)
  1071.                   body_anlz(n->u[1].child, does_break, 0, 1, all);
  1072.                else
  1073.                   body_anlz(n->u[1].child, does_break, 0, 0, all);
  1074.                return 1;
  1075.             case ')':
  1076.                /*
  1077.                 * function call or declaration: <expr> ( <expr-list> )
  1078.                 */
  1079.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1080.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1081.                return call_ret(n->u[0].child);
  1082.             case ':':
  1083.             case Case:
  1084.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1085.                fall_thru = body_anlz(n->u[1].child, does_break, 0, 0, all);
  1086.                may_brnchto = 1;
  1087.                return fall_thru;
  1088.             case Switch:
  1089.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1090.                fall_thru = body_anlz(n->u[1].child, &break_chk, 0, 0, all);
  1091.                return fall_thru | break_chk;
  1092.             case While: {
  1093.            struct node *n0 = n->u[0].child;
  1094.                body_anlz(n0, does_break, 0, 0, all);
  1095.                body_anlz(n->u[1].child, &break_chk, 0, 0, all);
  1096.            /*
  1097.         * check for an infinite loop, while (1) ... :
  1098.                 *  a condition consisting of an IntConst with image=="1"
  1099.                 *  and no breaks in the body.
  1100.         */
  1101.            if (n0->nd_id == PrimryNd && n0->tok->tok_id == IntConst &&
  1102.            !strcmp(n0->tok->image,"1") && !break_chk)
  1103.           return 0;
  1104.                return 1;
  1105.            }
  1106.             case Do:
  1107.                /*
  1108.                 * Any "break;" statements in the body do not effect
  1109.                 *  outer loops so pass along a new flag for does_break.
  1110.                 */
  1111.                body_anlz(n->u[0].child, &break_chk, 0, 0, all);
  1112.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1113.                return 1;
  1114.             case Runerr:
  1115.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1116.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1117.                if (all)
  1118.                   ret_flag |= DoesEFail;  /* possibler error failure */
  1119.                return 0;
  1120.             case '=':
  1121.             case MultAsgn:  /*  *=  */
  1122.             case DivAsgn:   /*  /=  */
  1123.             case ModAsgn:   /*  %=  */
  1124.             case PlusAsgn:  /*  +=  */
  1125.             case MinusAsgn: /*  -=  */
  1126.             case LShftAsgn: /* <<=  */
  1127.             case RShftAsgn: /* >>=  */
  1128.             case AndAsgn:   /*  &=  */
  1129.             case XorAsgn:   /*  ^=  */
  1130.             case OrAsgn:    /*  |=  */
  1131.                /*
  1132.                 * Left operand is modified.
  1133.                 */
  1134.                body_anlz(n->u[0].child, does_break, 1, 0, all);
  1135.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1136.                return 1;
  1137.             default: /* binary operations that need nothing special */
  1138.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1139.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1140.                return 1;
  1141.             }
  1142.       case LstNd:
  1143.       case StrDclNd:
  1144.          /*
  1145.           * Some declaration code.
  1146.           */
  1147.          body_anlz(n->u[0].child, does_break, 0, 0, all);
  1148.          body_anlz(n->u[1].child, does_break, 0, 0, all);
  1149.          return 1;
  1150.       case ConCatNd:
  1151.         /*
  1152.          * <some-code> <some-code>
  1153.          */
  1154.          if (body_anlz(n->u[0].child, does_break, 0, 0, all))
  1155.             return body_anlz(n->u[1].child, does_break, 0, 0, all);
  1156.          else {
  1157.             /*
  1158.              * Cannot directly reach the second piece of code, see if
  1159.              *  it is possible to branch into it.
  1160.              */
  1161.             may_brnchto = 0;
  1162.             fall_thru = body_anlz(n->u[1].child, does_break, 0, 0, all);
  1163.             return may_brnchto & fall_thru;
  1164.             }
  1165.       case CommaNd:
  1166.          /*
  1167.           * <expr> , <expr>
  1168.           */
  1169.          fall_thru = body_anlz(n->u[0].child, does_break, 0, 0, all);
  1170.          return fall_thru & body_anlz(n->u[1].child, does_break, 0, 0, all);
  1171.       case CompNd:
  1172.          /*
  1173.           * Compound statement, look only at executable code.
  1174.           *
  1175.           *  First traverse declaration list looking for initializers.
  1176.           */
  1177.          n1 = n->u[0].child;
  1178.          while (n1 != NULL) {
  1179.             if (n1->nd_id == LstNd) {
  1180.                n2 = n1->u[1].child;
  1181.                n1 = n1->u[0].child;
  1182.                }
  1183.             else {
  1184.                n2 = n1;
  1185.                n1 = NULL;
  1186.                }
  1187.  
  1188.             /*
  1189.              * Get declarator list from declaration and traverse it.
  1190.              */
  1191.             n2 = n2->u[1].child;
  1192.             while (n2 != NULL) {
  1193.                if (n2->nd_id == CommaNd) {
  1194.                   n3 = n2->u[1].child;
  1195.                   n2 = n2->u[0].child;
  1196.                   }
  1197.                else {
  1198.                   n3 = n2;
  1199.                   n2 = NULL;
  1200.                   }
  1201.                if (n3->nd_id == BinryNd && n3->tok->tok_id == '=')
  1202.                    body_anlz(n3->u[1].child, does_break, 0, 0, all);
  1203.                }
  1204.             }
  1205.  
  1206.          /*
  1207.           * Check initializers on tended declarations.
  1208.           */
  1209.          for (sym = n->u[1].sym; sym != NULL; sym = sym->u.tnd_var.next)
  1210.             body_anlz(sym->u.tnd_var.init, does_break, 0, 0, all);
  1211.  
  1212.          /*
  1213.           * Do the statement list.
  1214.           */
  1215.          return body_anlz(n->u[2].child, does_break, 0, 0, all);
  1216.       case TrnryNd:
  1217.          switch (t->tok_id) {
  1218.             case Cnv:
  1219.                /*
  1220.                 * extended C code: cnv: <type> ( <source> )
  1221.                 *                  cnv: <type> ( <source> , <destination> )
  1222.                 *
  1223.                 *  For some conversions, buffers may have to be allocated.
  1224.                 *  An explicit destination must be marked as modified.
  1225.                 */
  1226.                if (all)
  1227.                   cnt_bufs(n->u[0].child);
  1228.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1229.                body_anlz(n->u[2].child, does_break, 1, 0, all);
  1230.                return 1;
  1231.             case If:
  1232.                /*
  1233.                 * Execution falls through an if statement if it falls
  1234.                 *  through either branch. A null "else" branch always
  1235.                 *  falls through.
  1236.                 */
  1237.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1238.                return body_anlz(n->u[1].child, does_break, 0, 0, all) |
  1239.                   body_anlz(n->u[2].child, does_break, 0, 0, all);
  1240.             case Type_case:
  1241.                /*
  1242.                 * type_case <expr> of { <section-list> }
  1243.                 * type_case <expr> of { <section-list> <default-clause> }
  1244.                 */
  1245.  
  1246.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1247.                /*
  1248.                 * Loop through the case clauses.
  1249.                 */
  1250.                fall_thru = 0;
  1251.                for (n1 = n->u[1].child; n1 != NULL; n1 = n1->u[0].child) {
  1252.                   n2 = n1->u[1].child->u[1].child;
  1253.                   fall_thru |= body_anlz(n2, does_break, 0, 0, all);
  1254.                   }
  1255.                return fall_thru | body_anlz(n->u[2].child, does_break, 0, 0,
  1256.                   all);
  1257.             default: /* nothing special is needed for these ternary nodes */
  1258.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1259.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1260.                body_anlz(n->u[2].child, does_break, 0, 0, all);
  1261.                return 1;
  1262.                }
  1263.       case QuadNd:
  1264.          if (t->tok_id == Def) {
  1265.                /*
  1266.                 * extended C code:
  1267.                 *   def: <type> ( <source> , <default> )
  1268.                 *   def: <type> ( <source> , <default> , <destination> )
  1269.                 *
  1270.                 *  For some conversions, buffers may have to be allocated.
  1271.                 *  An explicit destination must be marked as modified.
  1272.                 */
  1273.                if (all)
  1274.                   cnt_bufs(n->u[0].child);
  1275.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1276.                body_anlz(n->u[2].child, does_break, 0, 0, all);
  1277.                body_anlz(n->u[3].child, does_break, 1, 0, all);
  1278.                return 1;
  1279.                }
  1280.           else {  /* for */
  1281.                /*
  1282.                 * Check for an infinite loop:  for (<expr>; ; <expr> ) ...
  1283.                 *
  1284.                 *  No ending condition and no breaks in the body.
  1285.                 */
  1286.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1287.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1288.                body_anlz(n->u[2].child, does_break, 0, 0, all);
  1289.                body_anlz(n->u[3].child, &break_chk, 0, 0, all);
  1290.                if (n->u[1].child == NULL && !break_chk)
  1291.                   return 0;
  1292.                else
  1293.                   return 1;
  1294.                }
  1295.       }
  1296.    err1("rtt internal error detected in function body_anlz()");
  1297.    /* NOTREACHED */
  1298.    }
  1299.  
  1300. /*
  1301.  *  lcl_tend  - allocate any tended variables needed in this body or inline
  1302.  *   statement.
  1303.  */
  1304. static novalue lcl_tend(n)
  1305. struct node *n;
  1306.    {
  1307.    struct sym_entry *sym;
  1308.  
  1309.    if (n == NULL)
  1310.       return; 
  1311.  
  1312.    /*
  1313.     * Walk the syntax tree until a block with declarations is found.
  1314.     */
  1315.    switch (n->nd_id) {
  1316.       case PrefxNd:
  1317.       case PstfxNd:
  1318.       case PreSpcNd:
  1319.         lcl_tend(n->u[0].child);
  1320.         break;
  1321.       case BinryNd:
  1322.       case LstNd:
  1323.       case ConCatNd:
  1324.       case CommaNd:
  1325.       case StrDclNd:
  1326.         lcl_tend(n->u[0].child);
  1327.         lcl_tend(n->u[1].child);
  1328.         break;
  1329.       case CompNd:
  1330.          /*
  1331.           * Allocate the tended variables in this block, noting that the
  1332.           *  level of nesting in this C function is one less than in the
  1333.           *  operation as a whole. Then mark the tended slots as free for
  1334.           *  use in the next block.
  1335.           */
  1336.          for (sym = n->u[1].sym; sym != NULL; sym = sym->u.tnd_var.next) {
  1337.             sym->t_indx = alloc_tnd(sym->id_type, sym->u.tnd_var.init,
  1338.                sym->nest_lvl - 1);
  1339.             }
  1340.          lcl_tend(n->u[2].child);
  1341.          sym = n->u[1].sym;
  1342.          if (sym != NULL)
  1343.             unuse(tend_lst, sym->nest_lvl - 1);
  1344.          break;
  1345.       case TrnryNd:
  1346.          lcl_tend(n->u[0].child);
  1347.          lcl_tend(n->u[1].child);
  1348.          lcl_tend(n->u[2].child);
  1349.          break;
  1350.       case QuadNd:
  1351.          lcl_tend(n->u[0].child);
  1352.          lcl_tend(n->u[1].child);
  1353.          lcl_tend(n->u[2].child);
  1354.          lcl_tend(n->u[3].child);
  1355.          break;
  1356.       }
  1357.    }
  1358.  
  1359. /*
  1360.  * chkrettyp - check type of return to see if it is a C integer or a
  1361.  *  C double and make note of what is found.
  1362.  */
  1363. static novalue chkrettyp(n)
  1364. struct node *n;
  1365.    {
  1366.    if (n->nd_id == PrefxNd && n->tok != NULL) {
  1367.       switch (n->tok->tok_id) {
  1368.          case C_Integer:
  1369.             body_ret |= RetInt;
  1370.             return;
  1371.          case C_Double:
  1372.             body_ret |= RetDbl;
  1373.             return;
  1374.          }
  1375.       }
  1376.    body_ret |= RetOther;
  1377.    }
  1378.  
  1379. /*
  1380.  * body_fnc - produce the function which implements a body statement.
  1381.  */
  1382. static struct il_code *body_fnc(n)
  1383. struct node *n;
  1384.    {
  1385.    struct node *compound;
  1386.    struct node *dcls;
  1387.    struct node *stmts;
  1388.    struct var_lst *var_ref;
  1389.    struct sym_entry *sym;
  1390.    struct il_code *il;
  1391.    int fall_thru;          /* flag: control can fall through end of body */
  1392.    int num_sigs;           /* number of different signals function may return */
  1393.    int bprm_indx;
  1394.    int first;
  1395.    int is_reg;
  1396.    int strct;
  1397.    int addr;
  1398.    int by_ref;
  1399.    int just_desc;
  1400.    int dummy_int;
  1401.    char buf1[6];
  1402.    char buf[MaxFileName];
  1403.    char *cname;
  1404.  
  1405.    /*
  1406.     * Figure out the next character to use as the 3rd prefix for the
  1407.     *  name of this body function.
  1408.     */
  1409.    if (prfx3 == ' ')
  1410.       prfx3 = '0';
  1411.    else if (prfx3 == '9')
  1412.       prfx3 = 'a';
  1413.    else if (prfx3 == 'z')
  1414.       errt2(n->tok, "more than 26 body statements in", cur_impl->name);
  1415.    else
  1416.       ++prfx3;
  1417.  
  1418.    /*
  1419.     * Free any old body parameters and tended locations.
  1420.     */
  1421.    while (body_prms != NULL) {
  1422.       var_ref = body_prms;
  1423.       body_prms = body_prms->next;
  1424.       free((char *)var_ref);
  1425.       }
  1426.    free_tend();
  1427.  
  1428.    /*
  1429.     * Locate the outer declarations and statements from the body clause.
  1430.     */
  1431.    compound = n->u[0].child;
  1432.    dcls = compound->u[0].child;
  1433.    stmts = compound->u[2].child;
  1434.  
  1435.    /*
  1436.     * Analyze the body code to determine what the function's interface
  1437.     *  needs. body_anlz() does the work after the counters and flags
  1438.     *  are initialized.
  1439.     */
  1440.    n_tmp_str = 0;  /* number of temporary string buffers neeeded */
  1441.    n_tmp_cset = 0; /* number of temporary cset buffers needed */
  1442.    nxt_sbuf = 0;   /* next string buffer index; used in code generation */
  1443.    nxt_cbuf = 0;   /* next cset buffer index; used in code generation */
  1444.    n_bdy_prms = 0; /* number of variables needed as body function parameters */
  1445.    body_ret = 0;   /* flag: C values and/or non-C values returned */
  1446.    ret_flag = 0;   /* flag: return, suspend, fail, error fail */
  1447.    rslt_loc = 0;   /* flag: body code needs operations result location */
  1448.    fall_thru = body_anlz(compound, &dummy_int, 0, 0, 1);
  1449.    lcl_tend(n);    /* allocate tended descriptors needed */
  1450.  
  1451.  
  1452.    /*
  1453.     * Use the letter indicating operation type along with body function
  1454.     *  prefixes to construct the name of the file to hold the C code.
  1455.     */
  1456.    sprintf(buf1, "%c_%c%c%c", lc_letter, prfx1, prfx2, prfx3);
  1457.    cname = salloc(makename(buf, SourceDir, buf1, CSuffix));
  1458.    if ((out_file = fopen(cname, "w")) == NULL)
  1459.       err2("cannot open output file ", cname);
  1460.    else
  1461.       addrmlst(cname);
  1462.       
  1463.    prologue(); /* output standard comments and preprocessor directives */
  1464.  
  1465.    /*
  1466.     * If the function produces a unique signal, the function need not actually
  1467.     *  return it, and we may be able to use the return value for something
  1468.     *  else. See if this is true.
  1469.     */
  1470.    num_sigs = 0;
  1471.    if (ret_flag & DoesRet)
  1472.       ++num_sigs;
  1473.    if (ret_flag & (DoesFail  | DoesEFail))
  1474.       ++num_sigs;
  1475.    if (ret_flag & DoesSusp)
  1476.       num_sigs += 2;    /* something > 1 (success cont. may return anything) */
  1477.    if (fall_thru) {
  1478.       ret_flag |= DoesFThru;
  1479.       ++num_sigs;
  1480.       }
  1481.  
  1482.    if (num_sigs > 1)
  1483.       fnc_ret = RetSig;  /* Function must return a signal */
  1484.    else {
  1485.       /*
  1486.        * If the body returns a C_integer or a C_double, we can make the
  1487.        *  function directly return the C value and the compiler can decide
  1488.        *  whether to construct a descriptor.
  1489.        */
  1490.       if (body_ret == RetInt || body_ret == RetDbl)
  1491.          fnc_ret = body_ret;
  1492.       else
  1493.          fnc_ret = RetNoVal; /* Function returns nothing directly */
  1494.       }
  1495.  
  1496.    /*
  1497.     * Decide whether the function needs to to be passed an explicit result
  1498.     *  location (the case where "result" is explicitly referenced is handled
  1499.     *  while analyzing the body). suspend always uses the result location.
  1500.     *  return uses the result location unless the function directly
  1501.     *  returns a C value.
  1502.     */
  1503.    if (ret_flag & DoesSusp)
  1504.       rslt_loc = 1;
  1505.    else if ((ret_flag & DoesRet) && (fnc_ret != RetInt && fnc_ret != RetDbl))
  1506.       rslt_loc = 1;
  1507.  
  1508.    /*
  1509.     * The data base entry for the call to the body function has 8 slots
  1510.     *  for standard interface information and 2 slots for each parameter.
  1511.     */
  1512.    il = new_il(IL_Call, 8 + 2 * n_bdy_prms);
  1513.    il->u[0].n = 0;         /* reserved for internal use by compiler */
  1514.    il->u[1].n = prfx3;
  1515.    il->u[2].n = fnc_ret;
  1516.    il->u[3].n = ret_flag;
  1517.    il->u[4].n = rslt_loc;
  1518.    il->u[5].n = 0;       /* number of string buffers to pass in: set below */
  1519.    il->u[6].n = 0;       /* number of cset buffers to pass in: set below */
  1520.    il->u[7].n = n_bdy_prms;
  1521.    bprm_indx = 8;
  1522.  
  1523.    /*
  1524.     * Write the C function header for the body function.
  1525.     */
  1526.    switch (fnc_ret) {
  1527.       case RetSig:
  1528.          fprintf(out_file, "int ");
  1529.          break;
  1530.       case RetInt:
  1531.          fprintf(out_file, "C_integer ");
  1532.          break;
  1533.       case RetDbl:
  1534.          fprintf(out_file, "double ");
  1535.          break;
  1536.       case RetNoVal:
  1537.          fprintf(out_file, "novalue ");
  1538.          break;
  1539.       }
  1540.    fprintf(out_file, " %c%c%c%c_%s(", uc_letter, prfx1, prfx2, prfx3,
  1541.         cur_impl->name);
  1542.    fname = cname;
  1543.    line = 7;
  1544.  
  1545.    /*
  1546.     * Write parameter list, first the parenthesized list of names. Start
  1547.     *  with names of RLT variables that must be passed in.
  1548.     */
  1549.    first = 1;
  1550.    for (var_ref = body_prms; var_ref != NULL; var_ref = var_ref->next) {
  1551.       sym = var_ref->sym;
  1552.       sym->id_type &= ~PrmMark;             /* unmark entry */
  1553.       if (first)
  1554.          first = 0;
  1555.       else
  1556.          prt_str(", ", IndentInc);
  1557.       prt_str(sym->image, IndentInc);
  1558.       }
  1559.  
  1560.    if (fall_thru) {
  1561.       /*
  1562.        * We cannot allocate string and cset buffers locally, so any
  1563.        *   that are needed must be parameters.
  1564.        */
  1565.       if (n_tmp_str > 0) {
  1566.          if (first)
  1567.             first = 0;
  1568.          else
  1569.             prt_str(", ", IndentInc);
  1570.          prt_str("r_sbuf", IndentInc);
  1571.          }
  1572.       if (n_tmp_cset > 0) {
  1573.          if (first)
  1574.             first = 0;
  1575.          else
  1576.             prt_str(", ", IndentInc);
  1577.          prt_str("r_cbuf", IndentInc);
  1578.          }
  1579.       }
  1580.  
  1581.    /*
  1582.     * If the result location is needed it is passed as the next parameter.
  1583.     */
  1584.    if (rslt_loc) {
  1585.       if (first)
  1586.          first = 0;
  1587.       else
  1588.          prt_str(", ", IndentInc);
  1589.       prt_str("r_rslt", IndentInc);
  1590.       }
  1591.  
  1592.    /*
  1593.     * If a success continuation is needed, it goes last.
  1594.     */
  1595.    if (ret_flag & DoesSusp) {
  1596.       if (!first)
  1597.          prt_str(", ", IndentInc);
  1598.       prt_str("r_s_cont", IndentInc);
  1599.       }
  1600.    prt_str(")", IndentInc);
  1601.    ForceNl();
  1602.  
  1603.    /*
  1604.     * Go through the parameters to this function writing out declarations
  1605.     *  and filling in rest of data base entry. Start with RLT variables.
  1606.     */
  1607.    for (var_ref = body_prms; var_ref != NULL; var_ref = var_ref->next) {
  1608.       /*
  1609.        * Each parameters has two slots in the data base entry. One
  1610.        *  is the declaration for use by iconc in producing function
  1611.        *  prototypes. The other is the argument that must be passed as
  1612.        *  part of the call generated by iconc.
  1613.        *
  1614.        * Determine whether the parameter is passed by reference or by
  1615.        *  value (flag by_ref). Tended variables that refer to just the
  1616.        *  vword of a descriptor require special handling. They must
  1617.        *  be passed to the body function as a pointer to the entire
  1618.        *  descriptor and not just the vword. Within the function the
  1619.        *  parameter is then accessed as x->vword... This is indicated
  1620.        *  by the parameter flag just_desc.
  1621.        */
  1622.       sym = var_ref->sym;
  1623.       var_ref->id_type = sym->id_type;      /* save old id_type */
  1624.       by_ref = 0;
  1625.       just_desc = 0;
  1626.       switch (sym->id_type) {
  1627.          case TndDesc:  /* tended struct descrip x */
  1628.             by_ref = 1;
  1629.             il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1630.             break;
  1631.          case TndStr:   /* tended char *x */
  1632.          case TndBlk:   /* tended struct b_??? *x or tended union block *x */
  1633.             by_ref = 1;
  1634.             just_desc = 1;
  1635.             il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1636.             break;
  1637.          case RtParm: /* undereferenced RTL parameter */
  1638.          case DrfPrm: /* dereferenced RTL parameter */
  1639.             switch (sym->u.param_info.cur_loc) {
  1640.                case PrmTend: /* plain parameter: descriptor */
  1641.                   by_ref = 1;
  1642.                   il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1643.                   break;
  1644.                case PrmCStr: /* parameter converted to a tended C string */
  1645.                   by_ref = 1;
  1646.                   just_desc = 1;
  1647.                   il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1648.                   break;
  1649.                case PrmInt:  /* parameter converted to a C integer */
  1650.                   sym->id_type = OtherDcl;
  1651.                   if (var_ref->sym->may_mod && fall_thru)
  1652.                      by_ref = 1;
  1653.                   il->u[bprm_indx++].c_cd = simpl_dcl("C_integer ", by_ref,
  1654.                      sym);
  1655.                   break;
  1656.                case PrmDbl: /* parameter converted to a C double */
  1657.                   sym->id_type = OtherDcl;
  1658.                   if (var_ref->sym->may_mod && fall_thru)
  1659.                      by_ref =  1;
  1660.                   il->u[bprm_indx++].c_cd = simpl_dcl("double ", by_ref, sym);
  1661.                   break;
  1662.                }
  1663.             break;
  1664.          case RtParm | VarPrm:
  1665.          case DrfPrm | VarPrm:
  1666.             /*
  1667.              * Variable part of RTL parameter list: already descriptor pointer.
  1668.              */
  1669.             sym->id_type = OtherDcl;
  1670.             il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1671.             break;
  1672.          case VArgLen:
  1673.             /*
  1674.              * Number of elements in variable part of RTL parameter list:
  1675.              *  integer but not a true variable.
  1676.              */
  1677.             sym->id_type = OtherDcl;
  1678.             il->u[bprm_indx++].c_cd = simpl_dcl("int ", 0, sym);
  1679.             break;
  1680.          case OtherDcl:
  1681.             is_reg = 0;
  1682.             /*
  1683.              * Pass by reference if it is a structure or union type (but
  1684.              *  not if it is a pointer to one) or if the variable is
  1685.              *  modified and it is possible to execute more code after the
  1686.              *  body. WARNING: crude assumptions are made for typedef
  1687.              *  types.
  1688.              */
  1689.             strct = strct_typ(sym->u.declare_var.tqual, &is_reg);
  1690.             addr = is_addr(sym->u.declare_var.dcltor, '\0');
  1691.             if ((strct && !addr) || (var_ref->sym->may_mod && fall_thru))
  1692.                   by_ref = 1;
  1693.             if (is_reg && by_ref)
  1694.               errt2(sym->u.declare_var.dcltor->u[1].child->tok, sym->image,
  1695.                  " may not be declared 'register'");
  1696.  
  1697.             il->u[bprm_indx++].c_cd = parm_dcl(by_ref, sym);
  1698.             break;
  1699.          }
  1700.  
  1701.       /*
  1702.        * Determine what the iconc generated argument in a function
  1703.        *  call should look like.
  1704.        */
  1705.       il->u[bprm_indx++].c_cd = bdy_prm(by_ref, just_desc, sym,
  1706.          var_ref->sym->may_mod);
  1707.  
  1708.       /*
  1709.        * If it a call-by-reference parameter, indicate that the level
  1710.        *  of indirection must be taken into account within the function
  1711.        *  body.
  1712.        */
  1713.       if (by_ref)
  1714.          sym->id_type |= ByRef;
  1715.       }
  1716.    
  1717.    if (fall_thru) {
  1718.       /*
  1719.        * Write declarations for any needed buffer parameters.
  1720.        */
  1721.       if (n_tmp_str > 0) {
  1722.          prt_str("char (*r_sbuf)[MaxCvtLen];", 0);
  1723.          ForceNl();
  1724.          }
  1725.       if (n_tmp_cset > 0) {
  1726.          prt_str("struct b_cset *r_cbuf;", 0);
  1727.          ForceNl();
  1728.          }
  1729.       /*
  1730.        * Indicate that buffers must be allocated by compiler and not
  1731.        *  within the function.
  1732.        */
  1733.       il->u[5].n = n_tmp_str;
  1734.       il->u[6].n = n_tmp_cset;
  1735.       n_tmp_str = 0;
  1736.       n_tmp_cset = 0;
  1737.       }
  1738.  
  1739.    /*
  1740.     * Write declarations for result location and success continuation
  1741.     *  parameters if they are needed.
  1742.     */
  1743.    if (rslt_loc) {
  1744.       prt_str("dptr r_rslt;", 0);
  1745.       ForceNl();
  1746.       }
  1747.    if (ret_flag & DoesSusp) {
  1748.       prt_str("continuation r_s_cont;", 0);
  1749.       ForceNl();
  1750.       }
  1751.  
  1752.    /*
  1753.     * Output the code for the function including ordinary declaration,
  1754.     *  special declarations, and executable code.
  1755.     */
  1756.    prt_str("{", IndentInc);
  1757.    ForceNl();
  1758.    c_walk(dcls, IndentInc, 0);
  1759.    spcl_dcls(NULL);
  1760.    c_walk(stmts, IndentInc, 0);
  1761.    ForceNl();
  1762.    /*
  1763.     * If it is possible for excution to fall through to the end of
  1764.     *  the body function, and it does so, return an A_FallThru signal.
  1765.     */
  1766.    if (fall_thru) {
  1767.       if (tend_lst != NULL) {
  1768.      prt_str("tend = tend->previous;", IndentInc);
  1769.      ForceNl();
  1770.          }
  1771.       if (fnc_ret == RetSig) {
  1772.          prt_str("return A_FallThru;", IndentInc);
  1773.          ForceNl();
  1774.          }
  1775.       }
  1776.    prt_str("}\n", IndentInc);
  1777.    if (fclose(out_file) != 0)
  1778.       err2("cannot close ", cname);
  1779.    put_c_fl(cname, 1);
  1780.  
  1781.    /*
  1782.     * Restore the symbol table to its previous state. Note any parameters
  1783.     *  that were modified by the body code.
  1784.     */
  1785.    for (var_ref = body_prms; var_ref != NULL; var_ref = var_ref->next) {
  1786.       sym = var_ref->sym;
  1787.       sym->id_type = var_ref->id_type;
  1788.       if (sym->id_type & DrfPrm)
  1789.          sym->u.param_info.parm_mod |= sym->may_mod;
  1790.       sym->may_mod = 0;
  1791.       }
  1792.  
  1793.    if (!fall_thru)
  1794.        clr_prmloc();
  1795.    return il;
  1796.    }
  1797.  
  1798. /*
  1799.  * strct_typ - determine if the declaration may be for a structured type
  1800.  *   and look for register declarations.
  1801.  */
  1802. static int strct_typ(typ, is_reg)
  1803. struct node *typ;
  1804. int *is_reg;
  1805.    {
  1806.    if (typ->nd_id == LstNd) {
  1807.       return strct_typ(typ->u[0].child, is_reg) |
  1808.          strct_typ(typ->u[1].child, is_reg);
  1809.       }
  1810.    else if (typ->nd_id == PrimryNd) {
  1811.       switch (typ->tok->tok_id) {
  1812.          case Typedef:
  1813.          case Extern:
  1814.             errt2(typ->tok, "declare {...} should not contain ",
  1815.                typ->tok->image);
  1816.          case Register:
  1817.             *is_reg = 1;
  1818.             return 0;
  1819.          case TypeDefName:
  1820.             if (strcmp(typ->tok->image, "word")  == 0 ||
  1821.                 strcmp(typ->tok->image, "uword") == 0 ||
  1822.                 strcmp(typ->tok->image, "dptr")  == 0)
  1823.                return 0;   /* assume non-structure type */
  1824.             else
  1825.                return 1;   /* might be a structure (is not C_integer) */
  1826.          default:
  1827.             return 0;
  1828.          }
  1829.       }
  1830.    else {
  1831.       /*
  1832.        * struct, union, or enum.
  1833.        */
  1834.       return 1;
  1835.       }
  1836.    }
  1837.  
  1838. /*
  1839.  * determine if the variable being declared evaluates to an address.
  1840.  */
  1841. static int is_addr(dcltor, modifier)
  1842. struct node *dcltor;
  1843. int modifier;
  1844.    {
  1845.    switch (dcltor->nd_id) {
  1846.       case ConCatNd:
  1847.          /*
  1848.           * pointer?
  1849.           */
  1850.          if (dcltor->u[0].child != NULL)
  1851.             modifier = '*';
  1852.          return is_addr(dcltor->u[1].child, modifier);
  1853.       case PrimryNd:
  1854.          /*
  1855.           * We have reached the name.
  1856.           */
  1857.          switch (modifier) {
  1858.             case '\0':
  1859.                return 0;
  1860.             case '*':
  1861.             case '[':
  1862.                return 1;
  1863.             case ')':
  1864.                errt1(dcltor->tok,
  1865.                   "declare {...} should not contain a prototype");
  1866.             }
  1867.       case PrefxNd:
  1868.          /*
  1869.           * (...)
  1870.           */
  1871.          return is_addr(dcltor->u[0].child, modifier);
  1872.       case BinryNd:
  1873.          /*
  1874.           * function or array.
  1875.           */
  1876.          return is_addr(dcltor->u[0].child, dcltor->tok->tok_id);
  1877.       }
  1878.    err1("rtt internal error detected in function is_addr()");
  1879.    /* NOTREACHED */
  1880.    }
  1881.  
  1882. /*
  1883.  * chgn_ploc - if this is an "in-place" conversion to a C value, change
  1884.  *  the "location" of the parameter being converted.
  1885.  */
  1886. static novalue chng_ploc(typcd, src)
  1887. int typcd;
  1888. struct node *src;
  1889.    {
  1890.    int loc;
  1891.  
  1892.    /*
  1893.     * Note, we know this is a valid conversion, because it got through
  1894.     *  pass 1.
  1895.     */
  1896.    loc = PrmTend;
  1897.    switch (typcd) {
  1898.       case TypCInt:
  1899.       case TypECInt:
  1900.          loc = PrmInt;
  1901.          break;
  1902.       case TypCDbl:
  1903.          loc = PrmDbl;
  1904.          break;
  1905.       case TypCStr:
  1906.          loc = PrmCStr;
  1907.          break;
  1908.       }
  1909.    if (loc != PrmTend)
  1910.       src->u[0].sym->u.param_info.cur_loc = loc;
  1911.    }
  1912.  
  1913. /*
  1914.  * cnt_bufs - See if we need to allocate a string or cset buffer for
  1915.  *  this conversion.
  1916.  */
  1917. static novalue cnt_bufs(cnv_typ)
  1918. struct node *cnv_typ;
  1919.    {
  1920.    if (cnv_typ->nd_id == PrimryNd)
  1921.       switch (cnv_typ->tok->tok_id) {
  1922.          case Tmp_string:
  1923.             ++n_tmp_str;
  1924.             break;
  1925.          case Tmp_cset:
  1926.             ++n_tmp_cset;
  1927.             break;
  1928.          }
  1929.    }
  1930.  
  1931. /*
  1932.  * mrg_abstr - merge (join) types of abstract returns on two execution paths.
  1933.  *   The type lattice has three levels: NoAbstr is bottom, SomeType is top,
  1934.  *   and individual types form the middle level.
  1935.  */
  1936. static int mrg_abstr(sum, typ)
  1937. int sum;
  1938. int typ;
  1939.    {
  1940.    if (sum == NoAbstr)
  1941.       return typ;
  1942.    else if (typ == NoAbstr)
  1943.       return sum;
  1944.    else if (sum == typ)
  1945.       return sum;
  1946.    else
  1947.       return SomeType;
  1948.    }
  1949. #endif                    /* Rttx */
  1950.